home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / graffi1a / graphitt.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-10-01  |  4.3 KB  |  100 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Graphitti by oigres P"
  4.    ClientHeight    =   3195
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   4680
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   213
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   312
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.CommandButton Command1 
  14.       Caption         =   "Clear Graphitti"
  15.       Height          =   495
  16.       Left            =   390
  17.       TabIndex        =   0
  18.       Top             =   1335
  19.       Width           =   1080
  20.    End
  21. Attribute VB_Name = "Form1"
  22. Attribute VB_GlobalNameSpace = False
  23. Attribute VB_Creatable = False
  24. Attribute VB_PredeclaredId = True
  25. Attribute VB_Exposed = False
  26. Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
  27. Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Long, ByVal bErase As Long) As Long
  28. Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
  29. Private Declare Function ReleaseCapture Lib "user32" () As Long
  30. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  31. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  32. Private Declare Function GetDesktopWindow Lib "user32" () As Long
  33. Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  34. Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
  35. Private Declare Function CreateDCBynum Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Long) As Long
  36. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  37. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  38. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  39. Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
  40. Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As RECT, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
  41. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  42. Private Type RECT
  43.     Left As Long
  44.     Top As Long
  45.     Right As Long
  46.     Bottom As Long
  47. End Type
  48. Private Type POINTAPI
  49.     x As Long
  50.     y As Long
  51. End Type
  52. Private Const HWND_BROADCAST = -1
  53. Private Const WM_PALETTECHANGED = &H311
  54. Private Const WM_SYSCOLORCHANGE = &H15
  55. Private Const WM_PAINT = &HF
  56. Dim down As Boolean
  57. Private Sub Command1_Click()
  58.    'Repaint all windows : Hint from Desktop3 by Paul
  59.    InvalidateRect 0&, 0&, False
  60. End Sub
  61. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  62.     'stop painting
  63.     down = True
  64.     Form1.MousePointer = 2
  65.     SetCapture Form1.hwnd
  66. End Sub
  67. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  68.     Dim cp As POINTAPI
  69.     Dim DeskTophwnd As Long, mydc As Long
  70.     Dim DeviceContextHandle As Long, olddc As Long
  71.     'if the mouse is down
  72.     If down = True Then
  73.         cp.x = x: cp.y = y
  74.         'ScreenToClient Form1.hwnd, cp
  75.         'convert our form coordinates to screen coordinates
  76.         ClientToScreen Form1.hwnd, cp
  77.         'Debug.Print cp.x; cp.y
  78.         DeskTophwnd = GetDesktopWindow
  79.         mydc = GetDC(DeskTophwnd)
  80.         'make a device context for the screen
  81.         DeviceContextHandle = CreateDCBynum("DISPLAY", vbNullString, vbNullString, 0&)
  82.         olddc = SelectObject(DeviceContextHandle, mydc)
  83.         'paint the device context
  84.         For brushwidth = 0 To 3
  85.             SetPixel DeviceContextHandle, cp.x + brushwidth, cp.y + brushwidth, &HFF00FF
  86.         Next brushwidth
  87.         
  88.         DeleteDC DeviceContextHandle
  89.         'restore the previous context
  90.         SelectObject mydc, olddc
  91.         'getdc needs to have the dc released
  92.         ReleaseDC DeskTophwnd, mydc
  93.     End If
  94. End Sub
  95. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  96.     down = False
  97.      Form1.MousePointer = 0
  98.     ReleaseCapture
  99. End Sub
  100.